perm filename CVT.F4[PAG,LCS] blob sn#530765 filedate 1980-08-12 generic text, type T, neo UTF8
      DIMENSION BARS(509),SN(2500),JWDS(300)
	COMMON /DREAD/DREAD(0/32),JREAD,KREAD
	COMMON/STF/RSTFAC(0/7),RS /POSI/STFF(0/7),JJ2,JPQ
	1  /RSIG/RSIG(0/15) /IVV/NRD(100)
	COMMON/XRN/RN(4500) /PTR/KWDS(600)
	COMMON /PX/KPN(300) /Q/Q(2500)
22	FORMAT(A5,30I)
222	FORMAT(1XA5,'.DMD')
CC3	FORMAT(' TYPE FILE NAME.EXT -- '$)
3300	FORMAT(' TYPE FILE NAME -- '$)
	TYPE 3300
	ACCEPT 22,NAME

	CALL GETEXT(NAME,'TST')
C  LP IS START OF RN ARRAY THIS TIME
	CALL EXTIN(DREAD,128)
	JJ2=JREAD
	JPQ=KREAD
300	CALL EXTIN(KWDS,JJ2)
	CALL EXTIN(RN,JPQ)
400	TYPE 3300
	ACCEPT 22,NAME
 
	J=0
	N=0
	KKNT=1
	LKNT=1
	DO 1 K=1,JJ2
	L=KWDS(K)
	R=RN(L+2)
	KNT=RN(L)+2
	LL=L
	IF(R.GT.7)GO TO 7
	DO 2 KK=KKNT,KKNT+KNT
 	SN(KK)=RN(LL)
2	LL=LL+1
	J=J+1
	JWDS(J)=KKNT
	KKNT=KKNT+KNT+1
	GO TO 1
7	RN(L+2)=R-8
	DO 3 KK=LKNT,LKNT+KNT
 	Q(KK)=RN(LL)
3	LL=LL+1
	N=N+1
	KPN(N)=LKNT
	LKNT=LKNT+KNT+1
1	CONTINUE
	N=N+1
	KPN(N)=LKNT
CC	J=J+1
CC	JWDS(J)=KKNT
	DO 5 K=0,7
	RSTFAC(K)=DREAD(K)
5	STFF(K)=DREAD(K+9)
	JJ2=J+1
	JPQ=KKNT
	CALL PUTEXT(NAME,'DMD')
	RSTFAC(99)=0
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(JWDS,J)
	CALL EXTOUT(SN,KKNT)
	CALL FINEXT
	TYPE 222,NAME
	JJ2=N+1
	JPQ=LKNT
	DO 6 K=0,7
	RSTFAC(K)=DREAD(K+8)
6	STFF(K)=DREAD(K+17)
	NAME=NAME+2
	CALL PUTEXT(NAME,'DMD')
	RSTFAC(99)=0
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(KPN,N)
	CALL EXTOUT(Q,LKNT)
	CALL FINEXT
	TYPE 222,NAME
	END